home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #119 (1991-03)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #119 (1991-03)(Amiga User Group Deutschland e.V.).adf / AmigaBASIC_Programme / Maßstab-x (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-03  |  9KB  |  166 lines
  1.     '**********  M a ß s t a b  x  **********
  2.     '*                                      *
  3.     '*  © Oktober 1988 by Michael Gottwald  *
  4.     '*                                      *
  5.     '****************************************
  6.     
  7.  ON ERROR GOTO Fehler
  8.  
  9. Start: PALETTE 0,0.25,0.25,0.25:PALETTE 2,0,0.7,0:PALETTE 3,0,0,1:COLOR 1,3
  10.        CIRCLE (320,12),160,3,,,0.07:PAINT (250,12),3:LOCATE 2,32:m$="Km"
  11.        PRINT" M A ß S T A B  X ":LOCATE 5,2:COLOR 2,0:b=0
  12.        PRINT"Dieses Programm berechnet aus dem den eingegebenen Maßen - das";
  13.        PRINT" können Ent-":PRINT" fernungen, Durchmesser, Längen ,Breiten";
  14.        PRINT" oder Höhen sein - ein zweites Maß-":PRINT" system, in dem ";
  15.        PRINT"die Maße maßstabsgerecht verkleinert oder vergrößert werden."
  16.        PRINT" Daraus wird dann eine Tabelle erstellt.":PRINT
  17.        PRINT" Hierzu ein Beispiel: Sie haben die Entfernungen und Durchme";
  18.        PRINT"sser der Planeten":PRINT" voneinander und der Sonne eingegeben."
  19.        PRINT" Nun sagen Sie, die Entfernung Erde-Mond (ø 384403 Km) soll nu";
  20.        PRINT"n auf 100 Meter":PRINT" zusammenschrumpfen. Wie weit wäre dann";
  21.        PRINT" die Sonne von unserer Erde entfernt ?":PRINT" (ø 149597000 Km";
  22.        PRINT") - knapp 39 Km !":PRINT:PRINT" Der Sinn des Programms ist es ";
  23.        PRINT"- basierend auf einem Maßstab (z.B. 'Erde-Mond"
  24.        PRINT" = 0.1 Km) eine Tabelle zu erstellen. Damit können große Ent";
  25.        PRINT"fernungen ver-":PRINT" kleinert werden und in unsere Vorstell";
  26.        PRINT"ungsswelt gerückt werden. Das ist":PRINT" sinnvoll, wenn man";
  27.        PRINT" beispielsweise die Entfernungen in unserem Sonnensystem"
  28.        PRINT" verständlich machen will.":LINE (8,167)-(639,176),2,bf
  29.        LOCATE 22,27:COLOR 1,2:PRINT"© 1988 by Michael Gottwald":LOCATE 20,63
  30.        COLOR 0,2:PRINT" Taste drücken ":WHILE INKEY$="":WEND:COLOR 1,0:CLS
  31.        LOCATE 2,2:PRINT"Wieviel Datensätze wollen Sie speichern ? (mind. 21";
  32.        PRINT", da 21 im Programm vor-":PRINT" gespeichert sind !)":PRINT
  33.        PRINT" (Jeweils [Name,Zahl] = 1 Datensatz !)":COLOR 2,0:LOCATE 10,1
  34. Anzahl: INPUT " Anzahl der Datensätze: ",ag:IF ag<21 THEN BEEP:GOTO Anzahl
  35.         ag=ag-1:a=20:DIM d(ag*2+1),d$(ag):FOR i=0 TO 20:READ d$(i),d(i)
  36.         IF LEFT$(d$(i),1)<>"ø" THEN d(i)=d(i)*1000000
  37.         :NEXT 
  38. Menue:  CLS:COLOR 1,3:FOR i=16 TO 617 STEP 8:LINE (i,0)-(i,24),3:NEXT
  39.         FOR i=0 TO 24 STEP 4:LINE (16,i)-(617,i),3:NEXT:LOCATE 2,35
  40.         PRINT" M E N Ü ":LINE (16,40)-(617,160),1,b:PAINT (20,60),3,1
  41.         LOCATE 7,21:COLOR 1,3:PRINT"<F1>   Vorhandene Datei löschen"
  42.         LOCATE 9,21:PRINT"<F2>   Datei von Diskette laden":LOCATE 11,21
  43.         PRINT"<F3>   Datei auf Diskette speichern":LOCATE 13,21
  44.         PRINT"<F4>   Tabelle berechnen":LOCATE 15,21
  45.         PRINT"<F5>   Tabelle zeigen":LOCATE 17,21:PRINT"<F6>   Tabelle aus";
  46.         PRINT"drucken":LOCATE 19,21:PRINT"<F7>   Daten eingeben":LOCATE 22,20
  47.         COLOR 1,3:PRINT" <ESC> beendet das Programm... " 
  48. Tasten:  k$=INKEY$:IF k$=CHR$(129) THEN Loeschen
  49.          IF k$=CHR$(130) THEN Laden
  50.          IF k$=CHR$(131) THEN Speichern
  51.          IF k$=CHR$(132) THEN Berechnen
  52.          IF k$=CHR$(133) THEN Zeigen
  53.          IF k$=CHR$(134) THEN Drucken
  54.          IF k$=CHR$(135) THEN Eingeben
  55.          IF k$=CHR$(27) THEN END
  56.         GOTO Tasten
  57. Loeschen: a$="D A T E N  L Ö S C H E N":GOSUB Titel:LOCATE 6,20:COLOR 1,0
  58.           PRINT"Wollen Sie wirklich alle Daten löschen ?":LOCATE 8,20
  59.           PRINT"Drücken Sie die ";:COLOR 0,1:PRINT" J ";:COLOR 1,0
  60.           PRINT" - oder ";:COLOR 0,1:PRINT" N ";:COLOR 1,0:PRINT" - Taste !"
  61. JoderN:   k$=INKEY$:IF k$="j"THEN LDaten
  62.           IF k$="n" THEN Menue
  63.          GOTO JoderN
  64. LDaten:   d(0)=0:d$(0)="":a=0:COLOR 2,0:PRINT:PRINT"Daten gelöscht !":PRINT
  65.           m$="":WHILE m$="":INPUT"Neue Maßeinheit ? (Km,m,cm,mm ...)";m$:WEND          
  66.           PRINT:GOTO Taste
  67. Laden:    a$="D A T E N  L A D E N":GOSUB Titel:LOCATE 6,1:COLOR 1,0
  68. Dname:    INPUT" Bitte geben Sie den Dateinamen an: ",n$:IF n$="" THEN Dname
  69.           OPEN "i",#1,n$:INPUT #1,a,m$:IF a>ag THEN Ueberlauf
  70.           FOR i=0 TO a:INPUT #1,d$(i),d(i):NEXT:CLOSE #1
  71. Taste:    COLOR 2,0:PRINT:PRINT SPC(18);" Bitte drücken Sie eine ";
  72.           PRINT"beliebige Taste...":WHILE INKEY$="":WEND:GOTO Menue 
  73. Ueberlauf: PRINT:PRINT" Die Datei ist größer als der reservierte Speicher !"
  74.            PRINT:PRINT" Starten Sie das Programm neu und reservieren Sie ";
  75.            PRINT"bitte"a+1"Datensätze !":PRINT:PRINT"Bis bald...":END
  76. Speichern:a$="D A T E N  S P E I C H E R N":GOSUB Titel:LOCATE 6,1:COLOR 1,0
  77. Sname:    INPUT" Bitte geben Sie den Dateiname an: ",n$:IF n$="" THEN Sname
  78.           OPEN n$ FOR OUTPUT AS #1:WRITE #1,a,m$:FOR i=0 TO a 
  79.           WRITE #1,d$(i),d(i):NEXT:CLOSE #1:GOTO Taste
  80. Berechnen:a$="B A S I S M A ß  B E R E C H N E N":GOSUB Titel:LOCATE 5,2
  81.           PRINT"Bitte scrollen Sie die Daten mit den Cursortasten, bis der ";
  82.           PRINT"gewünschte Daten-":PRINT" satz im grünen Feld ist ! Mit <EN";
  83.           PRINT"TER> wird der Datensatz ausgewählt.":n=0
  84. Scrollen: p=9:i=n:LINE (8,71)-(617,97),3,bf:WHILE p<12 AND i<=a:p=p+1
  85.           LOCATE p,3:IF p=10 THEN COLOR 1,2
  86.           PRINT d$(i),d(i);" ";m$:COLOR 1,3:i=i+1:WEND
  87. Cursor:   IF PEEK(12577793)=103 AND n>0 THEN n=n-1:GOTO Scrollen
  88.           IF PEEK(12577793)=101 AND n<a THEN n=n+1:GOTO Scrollen
  89.           IF PEEK(12577793)=119 THEN Nehmen
  90.          GOTO Cursor
  91. Nehmen:   COLOR 1,0:CLS:LOCATE 2,2:PRINT d$(n);" war bisher ";d(n)m$:PRINT
  92.           b=n:PRINT" Geben Sie bitte nun das neue Maß ein:":COLOR 2,0:PRINT
  93.           e=0:WHILE e=0:INPUT"-> ",e:WEND:FOR i=0 TO a:d(ag+1+i)=d(i)/d(n)*e
  94.           NEXT:GOTO Taste  
  95. Zeigen:  a$="Blättern mit den Cursortasten...      <ENTER> = ins Menü"
  96.          GOSUB Titel:LOCATE 4,15
  97.          COLOR 1,3:LINE (0,23)-(303,176),3,bf:LINE (304,23)-(463,176),2,bf
  98.          LINE (464,23)-(617,176),1,bf:PRINT"Kommentar":LOCATE 4,42:COLOR 1,2
  99.          PRINT"Bisheriges Maß":LOCATE 4,64:COLOR 3,1:PRINT"Neues Maß" 
  100.          LINE (0,33)-(617,33),0:n=0
  101. Tabelle: LINE (0,34)-(303,176),3,bf:LINE (304,34)-(463,176),2,bf:i=n:p=5
  102.          LINE (464,34)-(617,176),1,bf:WHILE p<22 AND i<=a:p=p+1:LOCATE p,1
  103.          COLOR 1,3:PRINT USING"\                                    \";d$(i) 
  104.          COLOR 1,2:LOCATE p,39
  105.          v$=MID$(STR$(d(i)),2)+" "+m$:PRINT USING"\                  \";v$
  106.          COLOR 3,1:LOCATE p,59             
  107.        v$=MID$(STR$(d(ag+1+i)),2)+" "+m$:PRINT USING"\                  \";v$
  108.          i=i+1:WEND
  109. Blaett:  IF PEEK(12577793)=119 THEN COLOR 1,0:GOTO Menue
  110.          IF PEEK(12577793)=103 AND n-8>=0 THEN n=n-8:GOTO Tabelle
  111.          IF PEEK(12577793)=101 AND n+8<=a+1 THEN n=n+8:GOTO Tabelle         
  112.         GOTO Blaett  
  113. Eingeben: a$="D A T E N  E I N G E B E N":GOSUB Titel:LOCATE 5,2
  114.           PRINT"Wollen Sie...":LOCATE 7,16:COLOR 1,3:PRINT" F1 ";:COLOR 1,0
  115.           PRINT" die neuen Daten anhängen,":LOCATE 9,16:COLOR 1,3 
  116.           PRINT" F2 ";:COLOR 1,0:PRINT" eine neue Datei anfangen," 
  117.           LOCATE 11,16:COLOR 1,3:PRINT" F3 ";:COLOR 1,0
  118.           PRINT" oder lieber wieder ins Menü zurück..."
  119. Auswahl:  k$=INKEY$:IF k$=CHR$(129) THEN Anhaengen
  120.           IF k$=CHR$(130) THEN a=-1:GOTO Anhaengen
  121.           IF k$=CHR$(131) THEN Menue
  122.          GOTO Auswahl
  123. Anhaengen: a$="D A T E N  A N H Ä N G E N":GOSUB Titel:LOCATE 5,3:w$=""
  124.            PRINT"Mit 'ende' wird die Eingabe beendet !":COLOR 2,0:PRINT
  125.            IF a=ag THEN PRINT" Nichts mehr frei !":GOTO Taste 
  126.            WHILE w$<>"ende" AND a<ag:PRINT" Es sind noch"ag-a"Datensät";
  127.            PRINT"ze frei...":PRINT:a=a+1:INPUT"Kommentar: ",w$
  128.            PRINT"Maß in "m$;:INPUT": ",d(a):d$(a)=w$:WEND
  129.            IF w$="ende" THEN a=a-1:GOTO Taste
  130.            PRINT" Datenspeicher voll !":GOTO Taste                                
  131. Drucken:  a$="T A B E L L E  A U S D R U C K E N":GOSUB Titel:LOCATE 8,15
  132.           PRINT"Bitte Drucker vorbereiten, dann <ENTER> drücken !"
  133.           WHILE INKEY$<>CHR$(13):WEND:OPEN "par:"FOR OUTPUT AS #2 
  134.           PRINT#2,SPC(16);CHR$(27);CHR$(14);"*** MASSUMRECHNUNG ***"
  135.           PRINT#2,"":PRINT#2,"Basismass:";STR$(d(b));" ";m$;" wird zu";
  136.           PRINT#2,STR$(d(b+ag+1));" ";m$:PRINT#2,"" 
  137.           PRINT#2,CHR$(27);CHR$(14);:PRINT#2,"Kommentar       Altes Mass ";
  138.           PRINT#2," Neues Mass  ":CLOSE #2:FOR i=0 TO a:w$=d$(i)
  139.           IF LEN(w$)>=38 THEN w$=LEFT$(w$,38) :ELSE w$=w$+SPACE$(38-LEN(w$)) 
  140.           LPRINT w$;:w$=STR$(d(i))+" "+m$ 
  141.           IF LEN(w$)>=21 THEN w$=LEFT$(w$,21) :ELSE w$=w$+SPACE$(21-LEN(w$))
  142.           LPRINT w$;:w$=STR$(d(i+a+1))+" "+m$
  143.           IF LEN(w$)>=21 THEN w$=LEFT$(w$,21) :ELSE w$=w$+SPACE$(21-LEN(w$))
  144.           LPRINT w$;:NEXT:LOCATE 11,21:PRINT"Datenübertragung zum Drucker ";
  145.           PRINT"beendet !":PRINT:GOTO Taste
  146. Titel:   COLOR 1,0:CLS:COLOR 3,2:CIRCLE (32,12),16,1,1.57,4.71
  147.          CIRCLE (600,12),16,1,4.71,1.57:LINE (32,4)-(600,4),1
  148.          LINE (32,20)-(600,20),1:PAINT (32,12),2,1:p=(640-LEN(a$)*8)/2
  149.          LOCATE 2:PRINT PTAB(p);a$:COLOR 1,0:RETURN           
  150. Fehler:  a$="F E H L E R !":GOSUB Titel:COLOR 1,0:IF ERR=53 THEN Disk
  151.          PRINT:PRINT" Fehlernummer =";ERR:GOTO Zurueck
  152. Disk:    LOCATE 8,5:PRINT"He Sie ! Entweder war das der falsche Name oder ";
  153.          PRINT"die Datei befindet sich":PRINT"    nicht auf dieser Diskette !"
  154. Zurueck: LOCATE 11,20:PRINT"Mit einer beliebigen Taste geht's weiter..."        
  155.          WHILE INKEY$="":WEND:RESUME Menue
  156.  
  157. Daten:        'Entfernungen in Millionen Kilometer !   = Durchmesser !
  158.        DATA "ø Sonne",1392530,"Entf. Sonne-Merkur",57.9,"ø Merkur",4878
  159.        DATA "Entf. Sonne-Venus",108.2,"ø Venus",12104,"Entf. Sonne-Erde"
  160.        DATA 149.6,"ø Erde",12756,"Entf. Sonne-Mars",227.9,"ø Mars",6794
  161.        DATA "Entf. Sonne-Jupiter",778.3,"ø Jupiter",142800
  162.        DATA "Entf. Sonne-Saturn",1427,"ø Saturn",120000,"Entf. Sonne-Uranus"
  163.        DATA 2870,"ø Uranus",51800,"Entf. Sonne-Neptun",4496.7,"ø Neptun"
  164.        DATA 50220,"Entf. Sonne-Pluto",5899,"ø Pluto (?)",3000,"Entf. Erde-Mond"
  165.        DATA .384403,"ø Mond",3444                
  166.